VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Equality"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private mResult As Boolean
Private mMessage As String
Private mStrMessage As New StringMessage
Private mStrDiff As New StringDifference

Public Property Get result() As Boolean
result = mResult
End Property

Public Property Get message() As String
message = mMessage
End Property

Public Function equals(LHS As Variant, RHS As Variant) As Boolean
Dim subtype As Integer
subtype = VarType(LHS)
Select Case subtype
Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDecimal, vbByte
    mResult = TestNumbers(LHS, RHS)
Case vbString
    mResult = TestStrings(LHS, RHS)
Case vbBoolean, vbDate
    mResult = DefaultTest(subtype, LHS, RHS)
Case vbObject
    mResult = TestObjects(LHS, RHS)
Case vbEmpty
    mResult = TestEmpty(LHS, RHS)
Case vbNull
    mResult = TestNull(LHS, RHS)
Case vbError
    mResult = DefaultTest(subtype, LHS, RHS)
End Select
equals = mResult
End Function

Private Function TestNumbers(LHS As Variant, RHS As Variant) As Boolean
Select Case VarType(RHS)
Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDecimal, vbByte
    TestNumbers = DefaultEquality(LHS, RHS)
Case Else
    TestNumbers = False
    mMessage = "Expected Numbers"
End Select
End Function
Private Function TestStrings(LHS As Variant, RHS As Variant) As Boolean
Select Case VarType(RHS)
Case vbString
    TestStrings = StringEquals(CStr(LHS), CStr(RHS))
Case Else
    TestStrings = False
    mMessage = "Expected Strings"
End Select
End Function

Private Function TestObjects(LHS As Variant, RHS As Variant) As Boolean
Select Case VarType(RHS)
Case vbObject
    TestObjects = ObjectEquals(LHS, RHS)
Case Else
    TestObjects = False
    mMessage = "Expected Objects"
End Select
End Function
Private Function TestEmpty(LHS As Variant, RHS As Variant) As Boolean
Select Case VarType(RHS)
Case vbEmpty
    TestEmpty = SingleValueTypeEquals(LHS, RHS)
Case Else
    TestEmpty = False
    mMessage = "Expected Empty"
End Select
End Function
Private Function TestNull(LHS As Variant, RHS As Variant) As Boolean
Select Case VarType(RHS)
Case vbNull
    TestNull = SingleValueTypeEquals(LHS, RHS)
Case Else
    TestNull = False
    mMessage = "Expected Null"
End Select
End Function

Private Function StringEquals(LHS As String, RHS As String) As Boolean
mStrDiff.compare LHS, RHS

mMessage = mStrDiff.message
StringEquals = mStrDiff.result
End Function

Private Function ObjectEquals(LHS As Variant, RHS As Variant) As Boolean
Dim ret As Boolean
ret = (LHS Is RHS)

ObjectMessage ret, LHS, RHS

ObjectEquals = ret
End Function
Private Function SingleValueTypeEquals(LHS As Variant, RHS As Variant) As Boolean

ObjectMessage True, LHS, RHS

SingleValueTypeEquals = True
End Function

Private Function DefaultTest(subtype As Integer, LHS As Variant, RHS As Variant) As Boolean
Select Case VarType(RHS)
Case subtype
    DefaultTest = DefaultEquality(LHS, RHS)
Case Else
    DefaultTest = False
    mMessage = "Expected " + TypeName(LHS) + "s"
End Select
End Function

Private Function DefaultEquality(LHS As Variant, RHS As Variant) As Boolean
Dim ret As Boolean
ret = (LHS = RHS)

DefaultMessage ret, LHS, RHS

DefaultEquality = ret
End Function

Private Sub ObjectMessage(result As Boolean, LHS As Variant, RHS As Variant)
mMessage = mStrMessage.message(result, TypeName(LHS), TypeName(RHS))
End Sub
Private Sub DefaultMessage(result As Boolean, LHS As Variant, RHS As Variant)
mMessage = mStrMessage.message(result, CStr(LHS), CStr(RHS))
End Sub

